perm filename PIT.SAI[11,ALS] blob sn#062419 filedate 1973-09-19 generic text, type T, neo UTF8
00010	BEGIN "PITGET"
00020	DEFINE ⊂="COMMENT"; ⊂ SEPT.,18,1973;
00030	DEFINE ⊃="⊂";
00040	INTEGER Z,I,J,K,L,M,N,P,PP,Q,R,MAX,POINTX,POINTY,STATE,DELTA,VAL,CHAN1,EOF;
00050	INTEGER POS,SEGC,LIM;
00060	INTEGER ARRAY BUF, PITS[0:2047];
00070	STRING FILEN,READ,READ1,FILEO,READ2,FILEQ;
00080	DEFINE CR="'15",LF="'12",TB="'11",CRLF="CR&LF";
00110	
00120	PROCEDURE OUTALL(STRING S);
00130	BEGIN
00140	STRING SS; INTEGER J;
00150	SETBREAK(18,0,NULL,"OSN");
00160	SS←SCAN(S,18,J);
00170	OUTSTR(SS);
00180	END;
00190	
00200	Z←0; LIM←20;
00210	FILEN←"FRST.001[CMP,NJM]";
00220	  FILEO←"SEG1.PIX";
00230	  POINTY←POINT(6,PITS[0],-1);
00260	CHAN1←1;
00270	FOR PP←1 STEP 1 UNTIL 31 DO BEGIN "FILEREAD"
00280	  CLOSE(CHAN1); OPEN(CHAN1,"DSK",'10,10,0,0,0,EOF);
00290	SETFORMAT(-3,0); FILEQ←CVS(PP);
00300	
00310	
00320	  FILEN←FILEN[1 TO 5]&FILEQ&"[CMP,NJM]";
00330	SETFORMAT(1,0);  FILEQ←CVS(PP);
00340	  FILEO←FILEO[1 TO 3]&FILEQ&".PIX";
00350	OUTSTR(CRLF&LF&FILEN); OUTSTR(TB&FILEO); OUTSTR(CRLF);
00360	LOOKUP(CHAN1,FILEN,0);
00370	J←K←L←STATE←VAL←R←0;
00380	SETFORMAT(6,0);
00410	MAX←0;
00420	WHILE EOF=0 DO BEGIN
00430	  FOR J←0 STEP 1 UNTIL 1023 DO BUF[J]←0;
00440	  ARRYIN(CHAN1,BUF[0],1024);
00450	  FOR I←0 STEP 1 UNTIL 511 DO  IF BUF[I+512]>MAX THEN MAX←BUF[I+512];
00460	  END;
00462	  OUTSTR("Max= "&CVS(MAX)&CRLF); MAX←MAX-LIM;
00463	OUTSTR("  "&TB);
00464	 FOR I←0 STEP 1 UNTIL 9 DO OUTSTR(CVS(I)); OUTSTR(CRLF&LF);
00466	Q←0;  OUTSTR(CVS(Q)&TB&"      ");
00470	  CLOSE(CHAN1); OPEN(CHAN1,"DSK",'10,10,0,0,0,EOF);
00480	LOOKUP(CHAN1,FILEN,0);
00490	M←POS←VAL←0; SEGC←1;
00500	
00510	WHILE EOF=0 DO BEGIN
00520	  FOR J←0 STEP 1 UNTIL 1023 DO BUF[J]←0;
00530	  ARRYIN(CHAN1,BUF[0],1024);
00540	  FOR I←0 STEP 1 UNTIL 511 DO BEGIN
00550	⊂    IF BUF[I]>POS+60 THEN VAL←(VAL LSH 3)%12;
00560	    IF BUF[I+512]>LIM THEN IF BUF[I+512]>VAL THEN BEGIN
00570	      N←((BUF[I+512]-LIM) LSH 6)%MAX; IF N>63 THEN N←63;
00580	      POS←BUF[I] LSH -7;
00590	      WHILE POS≥SEGC-1 DO BEGIN
00600	        IF POS>(SEGC) THEN BEGIN IDPB(Z,POINTY); OUTSTR("      ");END
00610	        ELSE BEGIN IDPB(N,POINTY); OUTSTR(CVS(N)); END;
00620	        SEGC←SEGC+1;
00625	        IF (P MOD 10)=9 THEN BEGIN
00630	          Q←Q+10; OUTSTR(CRLF&CVS(Q)&TB); P←0; END ELSE P←P+1;
00640	        END;
00645	      POS←BUF[I];
00650	      VAL←BUF[I+512];
00655	      END;
00660	    END;
00680	  END;
00690	
00700	CLOSE(CHAN1); OPEN(CHAN1,"DSK",'10,0,10,0,0,0);
00710	ENTER(CHAN1,FILEO,0); R←SEGC%6+2;
00720	ARRYOUT(CHAN1, PITS[0],R); RELEASE(CHAN1);
00730	
00740	END "FILEREAD";
00750	END "PITGET";